home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / language / pcl_src.zoo / cache.lsp < prev    next >
Text File  |  1992-09-09  |  60KB  |  1,601 lines
  1. ;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*-
  2. ;;;
  3. ;;; *************************************************************************
  4. ;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
  5. ;;; All rights reserved.
  6. ;;;
  7. ;;; Use and copying of this software and preparation of derivative works
  8. ;;; based upon this software are permitted.  Any distribution of this
  9. ;;; software or derivative works must comply with all applicable United
  10. ;;; States export control laws. 
  11. ;;; 
  12. ;;; This software is made available AS IS, and Xerox Corporation makes no
  13. ;;; warranty about the software, its performance or its conformity to any
  14. ;;; specification.
  15. ;;; 
  16. ;;; Any person obtaining a copy of this software is requested to send their
  17. ;;; name and post office or electronic mail address to:
  18. ;;;   CommonLoops Coordinator
  19. ;;;   Xerox PARC
  20. ;;;   3333 Coyote Hill Rd.
  21. ;;;   Palo Alto, CA 94304
  22. ;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)
  23. ;;;
  24. ;;; Suggestions, comments and requests for improvements are also welcome.
  25. ;;; *************************************************************************
  26. ;;;
  27. ;;; The basics of the PCL wrapper cache mechanism.
  28. ;;;
  29.  
  30. (in-package 'pcl)
  31. ;;;
  32. ;;; The caching algorithm implemented:
  33. ;;;
  34. ;;; << put a paper here >>
  35. ;;;
  36. ;;; For now, understand that as far as most of this code goes, a cache has
  37. ;;; two important properties.  The first is the number of wrappers used as
  38. ;;; keys in each cache line.  Throughout this code, this value is always
  39. ;;; called NKEYS.  The second is whether or not the cache lines of a cache
  40. ;;; store a value.  Throughout this code, this always called VALUEP.
  41. ;;;
  42. ;;; Depending on these values, there are three kinds of caches.
  43. ;;;
  44. ;;; NKEYS = 1, VALUEP = NIL
  45. ;;;
  46. ;;; In this kind of cache, each line is 1 word long.  No cache locking is
  47. ;;; needed since all read's in the cache are a single value.  Nevertheless
  48. ;;; line 0 (location 0) is reserved, to ensure that invalid wrappers will
  49. ;;; not get a first probe hit.
  50. ;;;
  51. ;;; To keep the code simpler, a cache lock count does appear in location 0
  52. ;;; of these caches, that count is incremented whenever data is written to
  53. ;;; the cache.  But, the actual lookup code (see make-dlap) doesn't need to
  54. ;;; do locking when reading the cache.
  55. ;;; 
  56. ;;;
  57. ;;; NKEYS = 1, VALUEP = T
  58. ;;;
  59. ;;; In this kind of cache, each line is 2 words long.  Cache locking must
  60. ;;; be done to ensure the synchronization of cache reads.  Line 0 of the
  61. ;;; cache (location 0) is reserved for the cache lock count.  Location 1
  62. ;;; of the cache is unused (in effect wasted).
  63. ;;; 
  64. ;;; NKEYS > 1
  65. ;;;
  66. ;;; In this kind of cache, the 0 word of the cache holds the lock count.
  67. ;;; The 1 word of the cache is line 0.  Line 0 of these caches is not
  68. ;;; reserved.
  69. ;;;
  70. ;;; This is done because in this sort of cache, the overhead of doing the
  71. ;;; cache probe is high enough that the 1+ required to offset the location
  72. ;;; is not a significant cost.  In addition, because of the larger line
  73. ;;; sizes, the space that would be wasted by reserving line 0 to hold the
  74. ;;; lock count is more significant.
  75. ;;;
  76.  
  77. (declaim (ftype (function () index)
  78.         get-wrapper-cache-number))
  79. (declaim (ftype (function (T T T) (values index index index index))
  80.                 compute-cache-parameters))
  81. (declaim (ftype (function (T T T) index)
  82.         compute-primary-cache-location
  83.         compute-primary-cache-location-from-location))
  84. (declaim (ftype (function (T) index)
  85.         cache-count))
  86. (declaim (ftype (function (T T T T) boolean)
  87.         fill-cache-p
  88.         fill-cache-from-cache-p))
  89. (declaim (ftype (function (T T &optional T) (values T boolean))
  90.         find-free-cache-line))
  91. (declaim (ftype (function (index) index)
  92.         compute-line-size
  93.         default-limit-fn
  94.         power-of-two-ceiling))
  95. (declaim (ftype (function (T) boolean)
  96.         free-cache-vector))
  97.  
  98.  
  99. ;;;
  100. ;;; Caches
  101. ;;;
  102. ;;; A cache is essentially just a vector.  The use of the individual `words'
  103. ;;; in the vector depends on particular properties of the cache as described
  104. ;;; above.
  105. ;;;
  106. ;;; This defines an abstraction for caches in terms of their most obvious
  107. ;;; implementation as simple vectors.  But, please notice that part of the
  108. ;;; implementation of this abstraction, is the function lap-out-cache-ref.
  109. ;;; This means that most port-specific modifications to the implementation
  110. ;;; of caches will require corresponding port-specific modifications to the
  111. ;;; lap code assembler.
  112. ;;;
  113. (defmacro cache-vector-ref (cache-vector location)
  114.   `(svref (the simple-vector ,cache-vector)
  115.           (#-cmu the #+cmu ext:truly-the fixnum ,location)))
  116.  
  117. (defun emit-cache-vector-ref (cache-vector-operand location-operand)
  118.   (operand :iref cache-vector-operand location-operand))
  119.  
  120.  
  121. (defmacro cache-vector-size (cache-vector)
  122.   `(array-dimension (the simple-vector ,cache-vector) 0))
  123.  
  124. (defun allocate-cache-vector (size)
  125.   (declare (type index size))
  126.   (make-array size :adjustable nil))
  127.  
  128. (defmacro cache-vector-lock-count (cache-vector)
  129.   `(cache-vector-ref ,cache-vector 0))
  130.  
  131. (defun flush-cache-vector-internal (cache-vector)
  132.   (without-interrupts-simple
  133.     (fill (the simple-vector cache-vector) nil)
  134.     (setf (cache-vector-lock-count cache-vector) 0))
  135.   cache-vector)
  136.  
  137. (defmacro modify-cache (cache-vector &body body)
  138.   `(without-interrupts-simple
  139.      (multiple-value-prog1
  140.        (progn ,@body)
  141.        (let ((old-count (cache-vector-lock-count ,cache-vector)))
  142.      (declare (type index old-count))
  143.      (setf (cache-vector-lock-count ,cache-vector)
  144.                (the index
  145.                 (if (= old-count most-positive-fixnum)
  146.                 1
  147.                         (the index (1+ old-count)))))))))
  148.  
  149. (deftype field-type ()
  150.   '(integer 0    ;#.(position 'number wrapper-layout)
  151.             7))  ;#.(position 'number wrapper-layout :from-end t)
  152.  
  153. (eval-when (compile load eval)
  154. (defun power-of-two-ceiling (x)
  155.   (declare (type index x))
  156.   ;;(expt 2 (ceiling (log x 2)))
  157.   (the index (ash 1 (integer-length (1- x)))))
  158.  
  159. (defconstant *nkeys-limit* 256)
  160. )
  161.  
  162. (defstruct (cache
  163.          (:print-function print-cache)
  164.          (:constructor make-cache ())
  165.          (:copier copy-cache-internal))
  166.   (nkeys 1 :type (integer 1 #.*nkeys-limit*))
  167.   (valuep nil :type boolean)
  168.   (nlines 0 :type index)
  169.   (field 0 :type field-type)
  170.   (limit-fn #'default-limit-fn :type real-function)
  171.   (mask 0 :type index)
  172.   (size 0 :type index)
  173.   (line-size 1 :type (integer 1 #.(power-of-two-ceiling (1+ *nkeys-limit*))))
  174.   (max-location 0 :type index)
  175.   (vector '#() :type simple-vector)
  176.   (overflow nil :type list))
  177.  
  178. (defun print-cache (cache stream depth)
  179.   (declare (ignore depth))
  180.   (printing-random-thing (cache stream)
  181.     (format stream "cache ~D ~S ~D" 
  182.         (cache-nkeys cache) (cache-valuep cache) (cache-nlines cache))))
  183.  
  184. #+akcl
  185. (si::freeze-defstruct 'cache)
  186.  
  187. (defmacro cache-lock-count (cache)
  188.   `(cache-vector-lock-count (cache-vector ,cache)))
  189.  
  190.  
  191. ;;;
  192. ;;; Some facilities for allocation and freeing caches as they are needed.
  193. ;;; This is done on the assumption that a better port of PCL will arrange
  194. ;;; to cons these all the same static area.  Given that, the fact that
  195. ;;; PCL tries to reuse them should be a win.
  196. ;;; 
  197. (defvar *free-cache-vectors* (make-hash-table :size 16 :test 'eql))
  198.  
  199. ;;;
  200. ;;; Return a cache that has had flush-cache-internal called on it.  This
  201. ;;; returns a cache of exactly the size requested, it won't ever return a
  202. ;;; larger cache.
  203. ;;; 
  204. (defun get-cache-vector (size)
  205.   (let ((entry (gethash size *free-cache-vectors*)))
  206.     (without-interrupts-simple
  207.       (cond ((null entry)
  208.          (setf (gethash size *free-cache-vectors*) (cons 0 nil))
  209.          (get-cache-vector size))
  210.         ((null (cdr entry))
  211.              (setf (car entry) (the fixnum (1+ (the fixnum (car entry)))))
  212.          (flush-cache-vector-internal (allocate-cache-vector size)))
  213.         (t
  214.          (let ((cache (cdr entry)))
  215.            (setf (cdr entry) (cache-vector-ref cache 0))
  216.            (flush-cache-vector-internal cache)))))))
  217.  
  218. (defun free-cache-vector (cache-vector)
  219.   (let ((entry (gethash (cache-vector-size cac